perm filename TAX75.F4[TAX,LCS] blob sn#206548 filedate 1976-03-15 generic text, type T, neo UTF8
00100	C***** INCOME TAX HELPER ******
00800		COMMON K,ACC,IOUT
00900		IOUT=5
01000	C****  'B'=BACKUP  ************** 'S' SKIPS SOME SECTIONS, 'SE' SKIPS TO END
01100	C*** UP TO 10 NUMBERS MAY BE ENTERED IF PROG. GIVES <CR> BEFORE ACCEPT.
01200	C  5=TTY  3=LPT
01300		ACC=-1
01400		TYPE 200
01500		ACCEPT 3,N
01600		IF(N.NE.'O')GO TO 60
01700	200	FORMAT(' N=NEW TAX WORK -- OR O=GET OLD FILE. H=HELP'/)
01800		TYPE 85
01900		ACCEPT 4,NAME
02000		GO TO 201
02100	33	FORMAT('+ STANDARD DEDUCTION - NOT MORE THAN $2000 OR $1000'/)
02200	60	FORMAT('+ TOTAL---   ',F10.2/)
02300		IF(N.NE.'H')GO TO 4
02400		TYPE 202
02500		CALL EXIT
02600	202	FORMAT(' ASK LCS FOR INFORMATION.')
02700	1	FORMAT(20F)
02800	2	FORMAT(F10.2/)
02900	3	FORMAT(A1)
03000	4	FORMAT(A5)
03100		I=' '
03200	
03300	601	FORMAT(' ***** YOU ARE ON FORM 1040, PG.1 *****'/)
03400		WRITE(IOUT,601)
03500		IF(ACC.EQ.0)GO TO 102
03600		TYPE 604
03700	604	FORMAT(' TO BACKUP TYPE B '/)
03800	600	FORMAT('+ ARE YOU MARRIED, FILING SEPARATELY? '$)
03900		CALL TYP(3,I)
04000		TYPE 600
04100		ACCEPT 3,MFS
04200		IF(RIC.EQ.'S')GO TO 6901
04300	102	CALL TYP(7,I)
04400		WRITE(IOUT, 11)
04500	11	FORMAT('+ NUMBER OF EXEMPTIONS  ',$)
04600		CALL ADUP(EX)
04700		IF(EX.EQ.'B')GO TO 600
04800	1100	CALL TYP(9,I)
04900		WRITE(IOUT, 12)
05000	12	FORMAT('+ WAGES, ETC. (FROM W2 FORMS)  '/)
05100		CALL ADUP(WG)
05200		IF(WG.EQ.'B')GO TO 102
05300	103	CALL TYP(10,'A')
05400		WRITE(IOUT, 13)
05500	13	FORMAT('+ DIVIDENDS.'/)
05600		CALL ADUP(DT)
05700		IF(DT.EQ.'B')GO TO 102
05800		IF(DT.EQ.0)GO TO 105
05900	104	CALL TYP(10,'B')
06000		WRITE(IOUT, 14)
06100	14	FORMAT('+ DIVIDEND EXCLUSION.  ',$)
06200		CALL ADUP(DEX)
06300		IF(DEX.EQ.'B')GO TO 103
06400		TOTD=DT-DEX
06500		CALL TYP(10,'C')
06600		WRITE(IOUT, 15)TOTD
06700	15	FORMAT('+ TOTAL DIVIDENDS.  ',F11.2/)
06800	105	CALL TYP(11,I)
06900		WRITE(IOUT, 16)
07000	16	FORMAT('+ INTEREST INCOME.  '/)
07100		CALL ADUP(RT)
07200		IF(RT.EQ.'B')GO TO 104
07300	106	CALL TYP(12,I)
07400		WRITE(IOUT, 17)
07500	17	FORMAT('+ OTHER INCOME.'/)
07600	602	FORMAT(' ***** GO TO PAGE 2 OF FORM 1040 *****'/,
07700		1' ***** TYPE  S  TO SKIP OVER SECTION AND RETURN TO PG.1'/ 
07800		1' ***** SE SKIPS TO LINE 44')
07900		IF(ACC.EQ.0.AND.T38.EQ.0)GO TO 1603
08000		WRITE(IOUT,602)
08100		CALL TYP(28,I)
08200		WRITE(IOUT, 18)
08300	18	FORMAT('+ BUSINESS INCOME-LOSS.'/)
08400		CALL ADUP(BI)
08500		IF(BI.EQ.-999)GO TO 1603
08600		IF(BI.EQ.'S')GO TO 6901
08700		IF(BI.EQ.'B')GO TO 105
08800	107	CALL TYP(29,'A')
08900		WRITE(IOUT, 19)
09000	19	FORMAT('+ CAPITAL ASSETS.'/)
09100		CALL ADUP(CA)
09200		IF(CA.EQ.'B')GO TO 106
09210	111	CALL TYP(29,'B')
09220		WRITE(IOUT, 23)
09230	23	FORMAT('+ 50% CAPITAL GAIN.'/)
09240		CALL ADUP(CP)
09250		IF(CP.EQ.'B')GO TO 107
09300	108	CALL TYP(30,I)
09400		WRITE(IOUT, 20)
09500	20	FORMAT('+ SUPPLEMENTAL SCHEDULE.'/)
09600		CALL ADUP(SU)
09700		IF(SU.EQ.'B')GO TO 111
09800	109	CALL TYP(31,'A')
09900		WRITE(IOUT, 21)
10000	21	FORMAT('+ RENTS, ROYALTIES, ETC.'/)
10100		CALL ADUP(RY)
10200		IF(RY.EQ.'B')GO TO 108
10300	110	CALL TYP(31,'B')
10400		WRITE(IOUT, 22)
10500	22	FORMAT('+ PENSIONS, ETC.'/)
10600		CALL ADUP(PE)
10700		IF(PE.EQ.'B')GO TO 109
11300	112	CALL TYP(33,I)
11400		WRITE(IOUT, 24)
11500	24	FORMAT('+ STATE INCOME TAX REFUNDS.'/)
11600		CALL ADUP(SI) 	
11700		IF(SI.EQ.'B')GO TO 111
11800	113	CALL TYP(34,I)
11900		WRITE(IOUT, 25)
12000	25	FORMAT('+ ALIMONY INCOME.  '/)
12100		CALL ADUP(ALM)
12200		IF(ALM.EQ.'B')GO TO 112
12300	114	CALL TYP(35,I)
12400		WRITE(IOUT, 26)
12500	26	FORMAT('+ OTHER.'/)
12600		CALL ADUP(OT)
12700		IF(OT.EQ.'B')GO TO 113
12800		CALL TYP(36,I)
12900		T36=BI+CA+SU+RY+PE+CP+SI+ALM+OT
13000		WRITE(IOUT, 60)T36
13100	603	FORMAT(' ***** GO BACK TO PAGE 1 OF FORM 1040 *****'/)
13200		WRITE(IOUT,603)
13300	1603	CALL TYP(12,I)
13400		IF(BI.EQ.-999)BI=0
13500		WRITE(IOUT,60)T36
13600		CALL TYP(13,I)
13700		T13=WG+TOTD+RT+T36
13800		WRITE(IOUT, 60)T13
13900	115	CALL TYP(14,I)
14000		WRITE(IOUT, 27)
14100	27	FORMAT('+ ADJUSTMENTS TO INCOME'/)
14200	
14300		IF(ACC.EQ.0.AND.T43.EQ.0)GO TO 1604
14400		WRITE(IOUT,602)
14500		CALL TYP(37,I)
14600		WRITE(IOUT, 28)
14700	28	FORMAT('+ SICK PAY.  ',/)
14800		CALL ADUP(SICK)
14900		IF(SICK.EQ.-999)GO TO 1604
15000		IF(SICK.EQ.'S')GO TO 6901
15100		IF(SICK.EQ.'B')GO TO 114
15200	116	CALL TYP(38,I)
15300		WRITE(IOUT, 29)
15400	29	FORMAT('+ MOVING EXPENSES.  ',/)
15500		CALL ADUP(RMEX)
15600		IF(RMEX.EQ.'B')GO TO 115
15700	117	CALL TYP(39,I)
15800		WRITE(IOUT, 30)
15900	30	FORMAT('+ EMPLOYEE BUSINESS EXPENSES.'/)
16000		CALL ADUP(EB) 
16100		IF(EB.EQ.'B')GO TO 116
16200	118	CALL TYP(40,'B')
16300		WRITE(IOUT, 31)
16400	31	FORMAT('+ SELF-EMPLOYED RETIREMENT PLAN.  '/)
16500		CALL ADUP(SER)
16600		IF(SER.EQ.'B')GO TO 117
16700		CALL TYP(42,I)
16800		T42=SICK+RMEX+EB+SER
16900		WRITE(IOUT, 60)T42
17000	
17100		WRITE(IOUT,603)
17200	1604	CALL TYP(14,I)
17300		IF(SICK.EQ.-999)SICK=0
17400		WRITE(IOUT, 60)T42
17500		T15=T13-T42
17600		CALL TYP(15,I)
17700		WRITE(IOUT, 32)T15
17800	32	FORMAT('+ ADJUSTED GROSS INCOME.',F13.2/)
17900		IF(T15.LT.10000.)CALL SMALL(T15)
18000		CALL STDED(T15)
18100		IF(ACC)WRITE(IOUT, 34)
18200	34	FORMAT(/' ***** ITEMIZE DEDUCTIONS? '$)
18300		IF(ACC)ACCEPT 3,JIT
18400		IF(JIT.EQ.'N')GO TO 6900
18500	C*************************************
18600	119	WRITE(IOUT, 35)
18700	35	FORMAT(/' ***** GO TO SCHEDULE A *****')
18800		WRITE(IOUT, 36)
18900	36	FORMAT(/' ----- MEDICAL - DENTAL '/)
19000		IF(ACC.EQ.0)GO TO 3700
19100		CALL TYP(1,I)
19200		WRITE(IOUT, 37)
19300	37	FORMAT('+ TOTAL OF INSURANCE PREMIUMS. '/)
19400		CALL ADUP(RMI)
19500		IF(RMI.EQ.'B')GO TO 118
19600	3700	T1=RMI/2.
19700		IF(T1.GT.150.)T1=150.
19800		CALL TYP(1,I)
19900		WRITE(IOUT, 2)T1
20000	120	CALL TYP(2,I)
20100		WRITE(IOUT, 38)
20200	38	FORMAT('+ MEDICINE AND DRUGS. '/)
20300		CALL ADUP(RM) 
20400		IF(RM.EQ.'B')GO TO 119
20500		CALL TYP(3,I)
20600	61	FORMAT('+ 1% OF LINE 15-- ',F10.2/)
20700		ONP=T15/100.
20800		WRITE(IOUT, 61)ONP
20900		T4=RM-ONP
21000		IF(T4)T4=0
21100		CALL TYP(4,I)
21200		WRITE(IOUT, 2)T4
21300		CALL TYP(5,I)
21400		T5=RMI-T1
21500		IF(T5)T5=0
21600	62	FORMAT('+ BALANCE OF INSURANCE PREMIUMS. ',F10.2/)
21700		WRITE(IOUT, 62)T5
21800		CALL TYP(6,I)
21900		WRITE(IOUT, 39)
22000	39	FORMAT('+ OTHER MEDICAL AND DENTAL EXPENSES.'/)
22100	121	CALL TYP(6,'A')
22200		WRITE(IOUT, 40)
22300	40	FORMAT('+ DOCTORS, DENTISTS, ETC.'/)
22400		CALL ADUP(DO)
22500		IF(DO.EQ.'B')GO TO 120
22600	122	CALL TYP(6,'B')
22700		WRITE(IOUT, 41)
22800	41	FORMAT('+ HOSPITALS.'/)
22900		CALL ADUP(HOSP)
23000		IF(HOSP.EQ.'B')GO TO 121
23100	123	CALL TYP(6,'C')
23200		WRITE(IOUT, 26)
23300		CALL ADUP(DOTH)
23400		IF(DOTH.EQ.'B')GO TO 122
23500		T7=T4+T5+DO+HOSP+DOTH
23600		CALL TYP(7,I)
23700		WRITE(IOUT, 60)T7
23800		T8=T15*.03
23900		CALL TYP(8,I)
24000		WRITE(IOUT, 2)T8
24100		T9=T7-T8
24200		IF(T9)T9=0
24300		CALL TYP(9,I)
24400		WRITE(IOUT, 2)T9
24500		T10=T9+T1
24600		CALL TYP(10,I)
24700		WRITE(IOUT, 60)T10
24800		CALL TYP(35,I)
24900		WRITE(IOUT, 60)T10
25000	
25100	43	FORMAT(/' ----- TAXES'/)
25200		WRITE(IOUT, 43)
25300	124	CALL TYP(11,I)
25400		WRITE(IOUT, 44)
25500	44	FORMAT('+ STATE AND LOCAL INCOME.'/)
25600		CALL ADUP(TA)
25700		IF(TA.EQ.'B')GO TO 123
25800	125	CALL TYP(12,I)
25900		WRITE(IOUT, 45)
26000	45	FORMAT('+ REAL ESTATE.'/)
26100		CALL ADUP(RX)
26200		IF(RX.EQ.'B')GO TO 124
26300	126	CALL TYP(13,I)
26400		WRITE(IOUT, 42)
26500	42	FORMAT('+ GASOLINE TAX (SEE TABLES)  '/)
26600		CALL ADUP(GTAX)
26700		IF(GTAX.EQ.'B')GO TO 125
26800	127	CALL TYP(14,I)
26900		WRITE(IOUT, 46)
27000	46	FORMAT('+ GENERAL SALES. (SEE TABLES) '/)
27100		CALL ADUP(STAX)
27200		IF(STAX.EQ.'B')GO TO 126
27300	128	CALL TYP(15,I)
27400		WRITE(IOUT, 47)
27500	47	FORMAT('+ PERSONAL PROPERTY'/)
27600		CALL ADUP(PTAX)
27700		IF(PTAX.EQ.'B')GO TO 127
27800	129	CALL TYP(16,I)
27900		WRITE(IOUT, 26)
28000		CALL ADUP(XO)
28100		IF(XO.EQ.'B')GO TO 128
28200		CALL TYP(17,I)
28300		T17=TA+RX+GTAX+STAX+PTAX+XO
28400		WRITE(IOUT, 60)T17
28500		CALL TYP(36,I)
28600		WRITE(IOUT, 60)T17
28700	130	WRITE(IOUT, 48)
28800	48	FORMAT(/' ----- INTEREST EXPENSE'/)
28900		CALL TYP(18,I)
29000		WRITE(IOUT, 49)
29100	49	FORMAT('+ HOME MORTGAGE.'/)
29200		CALL ADUP(RMO)
29300		IF(RMO.EQ.'B')GO TO 129
29400	131	CALL TYP(19,I)
29500		WRITE(IOUT, 26)
29600		CALL ADUP(ROH)
29700		IF(ROH.EQ.'B')GO TO 130
29800		CALL TYP(20,I)	
29900		T20=RMO+ROH
30000		WRITE(IOUT, 60)T20
30100		CALL TYP(37,I)
30200		WRITE(IOUT, 60)T20
30300	
30400	132	WRITE(IOUT, 50)
30500	50	FORMAT(/' ----- CONTRIBUTIONS '/)
30600		CALL TYP(21,'A')
30700		WRITE(IOUT, 51)
30800	51	FORMAT('+ CASH CONTRIBUTIONS.'/)
30900		CALL ADUP(CO)
31000		IF(CO.EQ.'B')GO TO 131
31100	133	CALL TYP(21,'B')
31200		WRITE(IOUT, 26)
31300		CALL ADUP(OC)
31400		IF(OC.EQ.'B')GO TO 132
31500	134	CALL TYP(22,I)
31600		WRITE(IOUT, 510)
31700	510	FORMAT('+ OTHER THAN CASH (SEE PAGE 12).'/)
31800		CALL ADUP(OCA)
31900		IF(OCA.EQ.'B')GO TO 133
32000	135	CALL TYP(23,I)
32100		WRITE(IOUT, 52)
32200	52	FORMAT('+ CARRY OVER FROM PRIOR YEARS.'/)
32300		CALL ADUP(PRIOR)
32400		IF(PRIOR.EQ.'B')GO TO 134
32500	136	CALL TYP(24,I)
32600		T24=PRIOR+OCA+OC+CO
32700		WRITE(IOUT, 60)T24
32800		CALL TYP(38,I)
32900		WRITE(IOUT, 60)T24
33000	137	WRITE(IOUT, 53)
33100	53	FORMAT(/' ----- CASUALTY OR THEFT LOSSES'/)
33200		CALL TYP(25,I)
33300	54	FORMAT('+ LOSS BEFORE INSURANCE REIMBURSEMENT.'/)
33400		WRITE(IOUT, 54)
33500		CALL ADUP(RLOSS)
33600		IF(RLOSS.EQ.'B')GO TO 135
33700		IF(RLOSS.EQ.0)GO TO 139
33800	138	CALL TYP(26,I)
33900		WRITE(IOUT, 55)
34000	55	FORMAT('+ INSURANCE REIMBURSEMENT.'/)
34100		CALL ADUP(RIR)
34200		IF(RIR.EQ.'B')GO TO 137
34300		CALL TYP(27,I)
34400		T27=RLOSS-RIR
34500		IF(T27)T27=0
34600		WRITE(IOUT, 60)T27
34700		T28=100.
34800		IF(T27.LT.T28)T28=T27
34900		CALL TYP(28,I)
35000		WRITE(IOUT, 2)T28
35100		T29=T27-T28
35200		CALL TYP(29,I)
35300		WRITE(IOUT, 60)T29
35400		CALL TYP(39,I)
35500		WRITE(IOUT, 60)T29
35600	139	WRITE(IOUT, 56)
35700	56	FORMAT(/' ----- MISCELLANEOUS DEDUCTIONS '/)
35800		CALL TYP(30,I)
35900		WRITE(IOUT, 57)
36000	57	FORMAT('+ ALIMONY PAID.'/)
36100		CALL ADUP(ALIMON)
36200		IF(ALIMON.EQ.'B')GO TO 138
36300	140	CALL TYP(31,I)
36400		WRITE(IOUT, 58)
36500	58	FORMAT('+ UNION DUES.'/)
36600		CALL ADUP(UN)
36700		IF(UN.EQ.'B')GO TO 139
36800	141	CALL TYP(32,I)
36900		WRITE(IOUT, 59)
37000	59	FORMAT('+ CHILD AND DEPENDENT CARE(FORM 2441)'/)
37100		CALL ADUP(CAD)
37200		IF(CAD.EQ.'B')GO TO 140
37300	142	CALL TYP(33,I)
37400		WRITE(IOUT, 26)
37500		CALL ADUP(SOTH)
37600		IF(SOTH.EQ.'B')GO TO 141
37700		T34=ALIMONY+UN+CAD+SOTH
37800		CALL TYP(34,I)
37900		WRITE(IOUT, 60)T34
38000		CALL TYP(40,I)
38100		WRITE(IOUT, 60)T34
38200		WRITE(IOUT, 63)
38300	63	FORMAT(' ----- SUMMARY OF DEDUCTIONS.'/)
38400		CALL TYP(35,I)
38500		WRITE(IOUT, 64)T10
38600	64	FORMAT('+ MEDICAL AND DENTAL.',F12.2/)
38700		CALL TYP(36,I)
38800		WRITE(IOUT, 65)T17
38900	65	FORMAT('+ TOTAL TAXES.',F12.2/)
39000	650	FORMAT('+ TOTAL INTEREST.',F12.2/)
39100	66	FORMAT('+ TOTAL CONTRIBUTIONS.',F12.2/)
39200	67	FORMAT('+ CASUALTY OR THEFT LOSS.',F12.2/)
39300	68	FORMAT('+ TOTAL MISCELLANEAOUS.',F12.2/)
39400	69	FORMAT('+ TOTAL DEDUCTIONS.',F12.2/)
39500		CALL TYP(37,I)
39600		WRITE(IOUT, 650)T20
39700		CALL TYP(38,I)
39800		WRITE(IOUT, 66)T24
39900		CALL TYP(39,I)
40000		WRITE(IOUT, 67)T29
40100		CALL TYP(40,I)
40200		WRITE(IOUT, 68)T34
40300		CALL TYP(41,I)
40400		T41=T34+T29+T20+T17+T10
40500		WRITE(IOUT, 69)T41
40600	
40700		WRITE(IOUT,602)
40800	6900	CALL TYP(43,I)
40900		WRITE(IOUT,32)T15
41000		IF(JIT.NE.'Y')GO TO 6901
41100		CALL TYP(44,'A')
41200		WRITE(IOUT, 69)T41
41300	6901	T44B=T15*.15
41400		X=2300
41500		IF(MFS.EQ.'Y')X=1300
41600		IF(T44B.GT.X)T44B=X
41700		CALL TYP(44,'B')
41800		WRITE(IOUT, 69)T44B
41900		T45=T15-T41
42000		T45B=T15-T44B
42100		IF(JIT.NE.'Y')GO TO 6902
42200		CALL TYP(45,'A')
42300		WRITE(IOUT, 2)T45
42400	6902	CALL TYP(45,'B')
42500		WRITE(IOUT, 2)T45B
42600		CALL TYP(46,I)
42700		X=EX*750
42800		WRITE(IOUT, 70)X
42900	70	FORMAT('+ EXEMPTIONS X $750.',F12.2/)
43000		IF(JIT.NE.'Y')GO TO 71
43100		CALL TYP(47,'A')
43200		T47=T45-X
43300		WRITE(IOUT, 71)T47
43400	71	FORMAT('+ TAXABLE INCOME -- ',F12.2/)
43500		T47B=T45B-X
43600		CALL TYP(47,'B')
43700		WRITE(IOUT, 71)T47B
43800	7216	WRITE(IOUT, 72)
43900	72	FORMAT(//' FIGURE YOUR TAX WITH SCHED. X,Y OR Z.'/
44000		1' USE SMALLEST OF 47A OR 47B (UNLESS ZERO).'/)
44100		IF(ACC.EQ.0)GO TO 73
44200	1722	TYPE 722
44300	722	FORMAT(' TYPE APPROPRIATE $, % AND $ FROM LAST 2 COLUMNS OF 
44400		1SCHEDULES X, Y OR Z.'/)
44500		ACCEPT 1,X,Y,Z
44600		IF(X.EQ.'B')GO TO 142
44700		IF(Y.LT.1)GO TO 1722
44800	C  TYPE PERCENTAGE AS NON-DECIMAL NUM.  I.E. 25=25%  NOT! .25
44900		IF(T47.LE.Z)GO TO 1722
45000		IF(JIT.NE.'Y')T47=T47B
45100		TAX=X+(T47-Z)*Y/100.
45200	CC	TAXB=X+(T47B-Z)*Y/100.
45300	73	FORMAT('+ YOUR TAX --  ',F12.2/)
45400		CALL TYP(16,I)
45500		WRITE(IOUT,73)TAX
45600	CC	CALL TYP(16,'B')
45700	CC	WRITE(IOUT,73)TAXB
45800	C******  CREDITS ********************
45900	741	FORMAT(' ----- CREDITS'/)
46000		WRITE(IOUT,741)
46100	
46200		IF(ACC.EQ.0.AND.T54.EQ.0)GO TO 1605
46300	1742	WRITE(IOUT,602)
46400		CALL TYP(48,I)
46500	742	FORMAT('+ RETIREMENT INCOME CREDIT. (SCHED. R) '/)
46600		WRITE(IOUT,742)
46700		CALL ADUP(RIC)
46800		IF(RIC.EQ.'S')GO TO 6901
46900		IF(RIC.EQ.-999)GO TO 1605
47000		IF(RIC.EQ.'B')GO TO 7216
47100	743	FORMAT('+ INVESTMENT CREDIT. (FORM 3468) '/)
47200		CALL TYP(49,I)
47300		WRITE(IOUT,743)
47400		CALL ADUP(RIVC)
47500		IF(RIVC.EQ.'B')GO TO 742
47600	744	FORMAT('+ FOREIGN TAX CREDIT. (FORM 1116) '/)
47700		CALL TYP(50,I)
47800		WRITE(IOUT,744)
47900		CALL ADUP(FTX)
48000		IF(FTX.EQ.'B')GO TO 743
48100	745	FORMAT('+ CREDIT FOR CONTRBS. TO CANDS. (SEE PG.9) '/)
48200		CALL TYP(51,I)
48300		WRITE(IOUT,745)
48400		CALL ADUP(CCC)
48500		IF(CCC.EQ.'B')GO TO 744
48600	746	FORMAT('+ WORK INCENTIVE CREDIT. (FORM 4874) '/)
48700		CALL TYP(52,I)
48800		WRITE(IOUT,746)
48900		CALL ADUP(WIC)
49000		IF(WIC.EQ.'B')GO TO 745
49010	1745	FORMAT('+ NEW RESID.  '/)
49020		CALL TYP(53,I)
49030		WRITE(IOUT,1745)
49040		CALL ADUP(PUR)
49050		IF(PUR.EQ.'B')GO TO 746
49100		CALL TYP(54,I)
49200		T54=RIC+FTX+CCC+WIC+RIVC+PUR
49300		WRITE(IOUT,60)T54
49400	C******************************* PAGE 1 AGAIN ***********
49500		WRITE(IOUT,603)
49600	1605	CALL TYP(17,I)
49700		IF(RIC.EQ.-999)RIC=0
49800		WRITE(IOUT, 74)T54
49900	74	FORMAT('+ TOTAL CREDITS.',F12.2/)
50000		T18=TAX-T54
50100		CALL TYP(18,I)
50200		WRITE(IOUT, 75),T18
50300	75	FORMAT('+ ******** INCOME TAX ******',F12.2/)
50400	C********  BACK TO PAGE 2 **************************
50500	760	FORMAT('+ SELF-EMPLOYMENT TAX. (SCHED. SE) [OUT OF ORDER]'/)
50600		IF(ACC.EQ.0.AND.T61.EQ.0)GO TO 1606
50700	1760	WRITE(IOUT,602)
50800		CALL TYP(59,I)
50900		WRITE(IOUT,760)
51000		CALL ADUP(SETX)
51100		IF(SETX.EQ.-999)GO TO 1606
51200		IF(SETX.EQ.'S')GO TO 6901
51300		IF(SETX.EQ.'B')GO TO 74
51400	761	FORMAT('+ TAX FROM RECOMPUTING INV.(FORM 4255) '/)
51500		CALL TYP(55,I)
51600		WRITE(IOUT,761)
51700		CALL ADUP(TRI)
51800		IF(TRI.EQ.'B')GO TO 760
51900	762	FORMAT('+ TAX FROM RECOMPUTING WIN. (+ SCHED.) '/)
52000		CALL TYP(56,I)
52100		WRITE(IOUT,762)
52200		CALL ADUP(TRW)
52300		IF(TRW.EQ.'B')GO TO 761
52400	763	FORMAT('+ MINIMUM TAX? (FORM 4625) '/)
52500		CALL TYP(57,I)
52600		WRITE(IOUT,763)
52700		CALL ADUP(RMT)
52800		IF(RMT.EQ.'B')GO TO 762
52900	764	FORMAT('+ SOCIAL SECURITY TAX ON TIPS. (FORM 4137) '/)
53000		CALL TYP(60,I)
53100		WRITE(IOUT,764)
53200		CALL ADUP(SST)
53300		IF(SST.EQ.'B')GO TO 763
53400	765	FORMAT('+ UNCOLLECTED SOC. SEC. TAX ON TIPS. '/)
53500		CALL TYP(61,I)
53600		WRITE(IOUT,765)
53700		CALL ADUP(TIPS)
53800		IF(TIPS.EQ.'B')GO TO 764
53805	758	FORMAT('+ PREM. DISTS. '/)
53810		CALL TYP(58,I)
53815		WRITE(IOUT,758)
53820		CALL ADUP(PREM)
53825		IF(PREM.EQ.'B')GO TO 765
53830	662	FORMAT('+ EXCESS CONTR.'/)
53840		CALL TYP(62,I)
53850		WRITE(IOUT,662)
53860		CALL ADUP(EXC)
53870		IF(EXC.EQ.'B')GO TO 758
53900		CALL TYP(63,I)
54000		T63=TIPS+SST+RMT+TRW+TRI+SETX+PREM+EXC
54100		WRITE(IOUT,60)T63
54200	
54300	C***** BACK TO PG.1 *******
54400		WRITE(IOUT,603)
54500	1606	CALL TYP(19,I)
54600		IF(SETX.EQ.-999)SETX=0
54700		WRITE(IOUT, 76)T63
54800	76	FORMAT('+ OTHER TAXES (LINE 63). ',F12.2/)
54900		T20T=TAX+T63
55000		CALL TYP(20,I)
55100		WRITE(IOUT, 60)T20T
55200	7721	CALL TYP(21,'A')
55300	77	FORMAT('+ FEDERAL TAX WITHHELD.'/)
55400		WRITE(IOUT, 77)
55500		CALL ADUP(WT)
55600		IF(WT.EQ.'B')GO TO 75
55700		CALL TYP(21,'A')
55800		WRITE(IOUT, 60)WT
55900	78	FORMAT('+ 1973 ESTIMATED TAX PAYMENTS.'/)
56000		CALL TYP(21,'B')
56100		WRITE(IOUT, 78)
56200		CALL ADUP(ET)
56300		IF(ET.EQ.'B')GO TO 77
56400	79	FORMAT('+ AMOUNT PAID WITH FORM 4868.  '/)
56500		CALL TYP(21,'C')
56600		WRITE(IOUT, 79)
56700		CALL ADUP(FORM)
56800		IF(FORM.EQ.'B')GO TO 78
56900	80	CALL TYP(21,'D')
57000		WRITE(IOUT, 26)
57100		
57200		IF(ACC.EQ.0.AND.T65.EQ.0)GO TO 1607
57300		WRITE(IOUT,602)
57400	800	FORMAT('+ EXCESS FICA TAX WITHHELD. (SEE PG.9) '/)
57500		CALL TYP(64,I)
57600		WRITE(IOUT,800)
57700		CALL ADUP(FIC)
57800		IF(FIC.EQ.'B')GO TO 78
57900		IF(FIC.EQ.-999)GO TO 1607
58000		IF(FIC.EQ.'S')GO TO 6901
58100	801	FORMAT('+ CREDIT FOR FED. TAX ON FUELS. (FORM 4136) '/)
58200		CALL TYP(65,I)
58300		WRITE(IOUT,801)
58400		CALL ADUP(FUEL)
58500		IF(FUEL.EQ.'B')GO TO 800
58600	802	FORMAT('+ CREDIT FROM REGULATED INVSTMT. CO. (FORM 2439) '/)
58700		CALL TYP(66,I)
58800		WRITE(IOUT,802)
58900		CALL ADUP(CRICC)
59000		IF(CRICC.EQ.'B')GO TO 801
59100		T65=FIC+FUEL+CRICC
59200		CALL TYP(65,T54,I)
59300		WRITE(IOUT,60)T65
59400	
59500		WRITE(IOUT,603)
59600	1607	CALL TYP(21,'D')
59700		IF(FIC.EQ.-999)FIC=0
59800		WRITE(IOUT, 26)
59900		IF(ACC.EQ.0)WRITE(IOUT,2)T65
60000		T22=WT+ET+FORM+T65
60100		CALL TYP(22,I)
60200		WRITE(IOUT, 60)T22
60300		T23=T20T-T22
60400		T23T=T23
60500		IF(T23T)T23T=0
60600		CALL TYP(23,I)
60700	82	FORMAT('+ BALANCE DUE. ------ ',F12.2/)
60800		WRITE(IOUT, 82)T23T
60900		T23=-T23
61000		IF(T23)T23=0
61100		CALL TYP(24,I)
61200		WRITE(IOUT, 83)T23
61300	83	FORMAT('+ OVERPAID ---------- ',F12.2)
61400		CALL TYP(25,I)
61500		WRITE(IOUT, 84)T23
61600	84	FORMAT('+ REFUNDED TO YOU --- ',F12.2)
61700		IF(IOUT.EQ.3)CALL EXIT
61800		IF(ACC.EQ.0)GO TO 860
61900		WRITE(IOUT, 85)
62000	85	FORMAT(//' TYPE FILE NAME.  '$)
62100		ACCEPT 4,NAME
62200		CALL OFILE(1,NAME)
62300		WRITE(1)
62400		1 RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
62500		1 TRW,TRI,SETX,FUEL,CRICC,FIC,ET,
62600		1 JIT,T63,T65,T54,
62700		1 EX,WG,DT,DEX,TOTD,RT,BI,CA,CP,SU,RY,PE,SI,
62800		1 ALM,OT,T36,T13,SICK,RMEX,EB,SER,T42,T15,RMI
62900		1,T1,RM,T4,T5,DO,HOSP,DOTH,T7,T8,T9,T10,TA,RX,GTAX,STAX
63000		WRITE(1)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
63100		1 T27,T28,T29,ALIMON,UN,SOTH,T34,T10,T17,T41,T44B,T45,T45B
63200		1,T47,T47B,TAX,T18,CRED,T20T,WT,FORM,T22,OTX
63300		1,T23T,T23,K
63400		GO TO 5
63500	201	CALL IFILE(21,NAME)
63600		READ(21)
63700		1 RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
63800		1 TRW,TRI,SETX,FUEL,CRICC,FIC,ET,
63900		1 JIT,T63,T65,T54,
64000		1 EX,WG,DT,DEX,TOTD,RT,BI,CA,CP,SU,RY,PE,SI,
64100		1 ALM,OT,T36,T13,SICK,RMEX,EB,SER,T42,T15,RMI
64200		1,T1,RM,T4,T5,DO,HOSP,DOTH,T7,T8,T9,T10,TA,RX,GTAX,STAX
64300		READ(21)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
64400		1 T27,T28,T29,ALIMON,UN,SOTH,T34,T10,T17,T41,T44B,T45,T45B
64500		1,T47,T47B,TAX,T18,CRED,T20T,WT,FORM,T22,OTX
64600		1,T23T,T23,K
64700	860	TYPE 86
64800	86	FORMAT(' R=REWORK, T=TYPE ON TTY, L=LIST ON LPT.'/)
64900		ACCEPT 3,N
65000		IF(N.EQ.'R')GO TO 87
65100		ACC=0
65200		IF(N.EQ.'T')GO TO 4 
65300		IOUT=3
65400		GO TO 4
65500	87	TYPE 88
65600	88	FORMAT(' START AT LINE 9,16,21,28,39,44,49,55,62 -- OR IN 
65700		1 SCHED. A, 1,11,18,25,30?'/)
65800		ACCEPT 1,X
65900		K=X
66000		IF(K.GT.30)GO TO 89
66100		GO TO(119,1,1,1,1,1,1,1, 1100,1, 43,1,1,1,1, 7216,1, 130,
66200		1 1,1, 7721,1,1,1, 137,1,1, 17,1, 139)K
66300	89	J=K-38
66400		GO TO(27,1,1,1,1,6900)J
66500		IF(K.EQ.49)GO TO 1742
66600		IF(K.EQ.55)GO TO 1760
66700		IF(K.EQ.62)GO TO 800
66800	5	END